

#######################
### Install and Load Libraries
#######################

packages <- c("ggplot2", "psych", "ltm", "Rmisc", "dplyr", "readr", 
              "janitor", "stargazer", "tidyr", "MatchIt", "purrr", 
              "broom", "lmtest", "pdftools", "tm", "scales")


# Install only the missing ones
install.packages(setdiff(packages, rownames(installed.packages())))

# Load all of them
lapply(packages, library, character.only = TRUE)


set.seed(89)


#######################
#### Load and rename datasets 
#######################

#Make sure that all file is saved in the same directory as your project to enable easy loading. 

# Loading datasets

load("FTX_Observational_Dataset_1.RData")        # This is the dataset for the first observational survey wave
load("FTX_Observational_Dataset_2.RData")        # This is the dataset for the second observational survey wave
load("FTX_Experimental_Datasets.RData")          # This is the dataset for the experimental survey data

# Cleaning datasets

Data_Obs_1 <- Data_FTX_Observation_14
Data_Obs_2 <- Data_FTX_Observation_145
Data_Exp <- Data_FTX

Data_Obs_Combined <- merge(Data_Obs_1, Data_Obs_2, 
                           by = "longitudinal_ID", 
                           all.x = TRUE)  # keeps all rows from Data_Obs_1

# Loading news corpuses for figure 4

nyt_raw <- pdf_text("nytimes_2.pdf")
nyt_text <- paste(nyt_raw, collapse = "\n")

msnbc_raw <- pdf_text("msnbc_articles.pdf")
full_text <- paste(msnbc_raw, collapse = "\n")

wsj_raw <- pdf_text("wsj_articles_chunk1.pdf")
wsj_text <- paste(wsj_raw, collapse = "\n")

fox_raw <- pdf_text("foxnews_articles_chunk1.pdf")
fox_text <- paste(fox_raw, collapse = "\n")



#######################
#### Figure 1 = Distribution of Depth of Exposure to FTX Scandal
#######################

jpeg("Figure_1.jpeg", width = 600, height = 380, quality = 100)

hist(Data_Obs_Combined$scandal_depth, freq = F,
     xlab = "Depth of Exposure to Scandal", 
     main = "",
     ylab = "Proportion of Sample",
     ylim = c(0, 0.4),
     breaks = c(-0.5, 0.5, 1.5, 2.5, 3.5, 4.5))

dev.off()


#######################
#### Table 1: Balance Checks for Scandal Awareness
#######################

# Preliminary Code to Run Balance Tests

get_mean_sd <- function(vector){
  mean <- mean(vector, na.rm = T)
  sd <- sd(vector, na.rm = T)
  sem <- sd/(sqrt(length(vector)))
  output <- paste(round(mean, 3), " (", round(sem, 3), ")", collapse = "", sep = "")
  return(output)
}

# Run Balance Tests

balance_data <- Data_Obs_Combined %>%
  mutate(scandal_aware = dplyr::recode(as.character(scandal_aware),
                                       "Unaware" = "Unexposed",
                                       "Aware"   = "Exposed")) %>%
  group_by(scandal_aware) %>%
  summarize(
    Age                     = get_mean_sd(age),
    Gender = {
      p <- mean(female == "Female", na.rm = TRUE)
      n <- sum(!is.na(female))
      se <- sqrt(p * (1 - p) / n)
      sprintf("%.3f (%.3f)", p, se)
    },
    Political_Orientation   = get_mean_sd(as.numeric(lr)),
    Education               = get_mean_sd(as.numeric(educ_fourlevels)),
    Income                  = get_mean_sd(as.numeric(income)),
    Crypto_Investor         = get_mean_sd(as.numeric(crypto_investor)),
    Political_Attentiveness = get_mean_sd(as.numeric(attentiveness)),
    News_Consumption        = get_mean_sd(as.numeric(news_consumption)),
    Political_Knowledge     = get_mean_sd(as.numeric(political_knowledge)),
    .groups = "drop"
  )

# Re-orient so variables are rows and groups are columns

balance_table_long <- balance_data %>%
  pivot_longer(cols = -scandal_aware,
               names_to = "Variable",
               values_to = "Value") %>%
  pivot_wider(names_from = scandal_aware,
              values_from = Value)

# Inspect
print(balance_table_long)

# Save to CSV
write.csv(balance_table_long, "Table_1.csv", row.names = FALSE)


# Code to see if any of the covariates in the balance test are statistically significantly different

Data_Obs_Combined$scandal_aware_numeric <- ifelse(Data_Obs_Combined$scandal_aware == "Aware", 1, 0)
Data_Obs_Combined$scandal_aware_numeric = as.numeric(Data_Obs_Combined$scandal_aware_numeric)

ProbitBalanceCheck <- glm(scandal_aware_numeric ~  
                            age + female + lr + educ_fourlevels + income + as.numeric(crypto_investor) 
                          + attentiveness + news_consumption + political_knowledge, data=Data_Obs_Combined) 
summary(ProbitBalanceCheck)



#######################
#### Figure 2: Effect of Scandal Awareness on Regulatory Preferences by Partisan Identity
#######################

jpeg("Figure_2.jpeg", width = 624, height = 464, quality = 100)

mod2 <- lm(crypto_regul_135_factor_score ~ scandal_aware*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
           data = Data_Obs_Combined)
summary(mod2)

par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[11] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[11, 11] + 2 * thermo_sim * vcov(mod2)[2, 11])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     main = "Figure 2: Effect of Scandal Awareness on Support \nfor Crypto Regulation by Partisan Identity",
     ylim = c(-0.8,0.8), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Obs_Combined$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()


#######################
#### Table 2: Perceived Causes of FTX Scandal
#######################

# Calculating Data

    # Systemic Corporate Greed
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Republican")$cause_systemic_corporate_greed, na.rm=T)
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Democrat")$cause_systemic_corporate_greed, na.rm=T)
    
    # Lack of sufficient regulation of the cryptocurrency industry
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Republican")$cause_lack_of_regulation, na.rm=T)
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Democrat")$cause_lack_of_regulation, na.rm=T)
    
    # Individual moral failings of the company’s leaders
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Republican")$cause_individual_moral_failings, na.rm=T)
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Democrat")$cause_individual_moral_failings, na.rm=T)
    
    # Failure of regulatory oversight bodies such as the SEC
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Republican")$cause_failure_regulatory_oversight, na.rm=T)
    mean(subset(Data_Obs_Combined, Party_ID_Wave4_2022_Elections == "Democrat")$cause_failure_regulatory_oversight, na.rm=T)


# Turning the above data into a table

causes <- c(
  "cause_systemic_corporate_greed",
  "cause_lack_of_regulation",
  "cause_individual_moral_failings",
  "cause_failure_regulatory_oversight"
)

labels <- c(
  "Systemic corporate greed",
  "Lack of sufficient regulation of the cryptocurrency industry",
  "Individual moral failings of the company's leaders",
  "Failure of regulatory oversight bodies such as the SEC"
)

# compute means by party (as proportions)
get_party_means <- function(varname, data, party_col = "Party_ID_Wave4_2022_Elections") {
  t <- tapply(data[[varname]], data[[party_col]], function(x) mean(x, na.rm = TRUE))
  # ensure both "Democrat" and "Republican" are present (NA if missing)
  c(
    Democrats  = ifelse("Democrat"  %in% names(t), t[["Democrat"]], NA_real_),
    Republicans= ifelse("Republican"%in% names(t), t[["Republican"]], NA_real_)
  )
}

res <- t(sapply(causes, get_party_means, data = Data_Obs_Combined))
res_df <- data.frame(
  Variable   = labels,
  Democrats  = sprintf("%d%%", round(100 * res[ , "Democrats"])),
  Republicans= sprintf("%d%%", round(100 * res[ , "Republicans"])),
  stringsAsFactors = FALSE
)

print(res_df)

write.csv(res_df, "Table_2.csv", row.names = FALSE)




#######################
#### Figure 3: Agreement with FTX Scandal Causes by Partisan Identity
#######################

jpeg("Figure_3.jpeg", width = 1300, height = 476, quality = 100)

par(mfrow = c(1, 2))

mean_individual_failings_by_lr <- aggregate(Data_Obs_Combined$cause_individual_moral_failings, by = list(Data_Obs_Combined$party_id_7point), FUN = mean, na.rm=T) 

plot(x = mean_individual_failings_by_lr$Group.1,
     y = mean_individual_failings_by_lr$x, 
     type = "b", # This option makes a cool graph with both lines and points!
     xlab = "Partisan Identity",
     ylab = "% agree that individual moral failings is key",
     ylim = c(0.12, 0.48),
     main = "Agreement that Cause is Individual Moral Failings")


mean_individual_failings_by_lr <- aggregate(Data_Obs_Combined$cause_lack_of_regulation, by = list(Data_Obs_Combined$party_id_7point), FUN = mean, na.rm=T) 

plot(x = mean_individual_failings_by_lr$Group.1,
     y = mean_individual_failings_by_lr$x, 
     type = "b", # This option makes a cool graph with both lines and points!
     xlab = "Partisan Identity",
     ylab = "% agree that lack of regulations is key",
     ylim = c(0.12, 0.48),
     main = "Agreement that Cause is Lack of Regulations")

par(mfrow = c(1, 1))

dev.off()


#######################
#### Figure 4: Proportion of Morality and Regulation Frames in FTX Coverage among Leftand Right-Leaning News Outlets
#######################

# Creating Dictionaries for Regulation and Morality Themes

regulation_dict <- c(
  "regulation", "regulations", "regulatory", "deregulation", 
  "unregulated", "underregulated","failure of regulation", "loophole", "capture", "enforcement", "oversight", "slack", "enforce"
)

morality_dict <- c(
  "moral", "immoral", "ethic", "ethical", "unethical",
  "hypocrisy", "hypocrite", "virtue", "sin", "democrat", "democrats", "villains",
  "liberal", "progressive", "bad", "villain", "luxurious", "scheme", "lavish lifestyle", "lifestyle", "elite", "elites",
  "political donations", "fame", "mistakes"
)


# Creating count function

count_dict_words <- function(dtm, dictionary) {
  terms <- Terms(dtm)
  matched <- terms[terms %in% dictionary]
  if (length(matched) == 0) return(rep(0, nrow(dtm)))
  rowSums(as.matrix(dtm[, matched, drop = FALSE]))
}


### Mapping New York Times articles

nyt_chunks <- unlist(strsplit(nyt_text, split = "\nHD ", fixed = TRUE))
nyt_chunks <- paste0("HD ", nyt_chunks)
nyt_chunks <- trimws(nyt_chunks)
nyt_chunks <- nyt_chunks[nchar(nyt_chunks) > 200]

nyt_corpus <- VCorpus(VectorSource(nyt_chunks))
nyt_clean <- tm_map(nyt_corpus, content_transformer(tolower))
nyt_clean <- tm_map(nyt_clean, removePunctuation)
nyt_clean <- tm_map(nyt_clean, removeNumbers)
nyt_clean <- tm_map(nyt_clean, stripWhitespace)

nyt_dtm <- DocumentTermMatrix(nyt_clean)

nyt_scores <- data.frame(
  regulation = count_dict_words(nyt_dtm, regulation_dict),
  morality   = count_dict_words(nyt_dtm, morality_dict),
  Outlet = "NYT"
)


### Mapping MSNBC articles

article_chunks <- unlist(strsplit(full_text, split = "Article [0-9]+:", perl = TRUE))
article_chunks <- trimws(article_chunks)
article_chunks <- article_chunks[nchar(article_chunks) > 200]

msnbc_corpus <- VCorpus(VectorSource(article_chunks))
msnbc_clean <- tm_map(msnbc_corpus, content_transformer(tolower))
msnbc_clean <- tm_map(msnbc_clean, removePunctuation)
msnbc_clean <- tm_map(msnbc_clean, removeNumbers)
msnbc_clean <- tm_map(msnbc_clean, stripWhitespace)

msnbc_dtm <- DocumentTermMatrix(msnbc_clean)

msnbc_scores <- data.frame(
  regulation = count_dict_words(msnbc_dtm, regulation_dict),
  morality   = count_dict_words(msnbc_dtm, morality_dict),
  Outlet = "MSNBC"
)


### Mapping Wall Street Journal articles

wsj_raw <- pdf_text("wsj_articles_chunk1.pdf")
wsj_text <- paste(wsj_raw, collapse = "\n")

wsj_chunks <- unlist(strsplit(wsj_text, split = "\nHD ", fixed = TRUE))
wsj_chunks <- paste0("HD ", wsj_chunks)
wsj_chunks <- trimws(wsj_chunks)
wsj_chunks <- wsj_chunks[nchar(wsj_chunks) > 200]

wsj_corpus <- VCorpus(VectorSource(wsj_chunks))
wsj_clean <- tm_map(wsj_corpus, content_transformer(tolower))
wsj_clean <- tm_map(wsj_clean, removePunctuation)
wsj_clean <- tm_map(wsj_clean, removeNumbers)
wsj_clean <- tm_map(wsj_clean, stripWhitespace)

wsj_dtm <- DocumentTermMatrix(wsj_clean)

wsj_scores <- data.frame(
  regulation = count_dict_words(wsj_dtm, regulation_dict),
  morality   = count_dict_words(wsj_dtm, morality_dict),
  Outlet = "WSJ"
)


### Mapping Fox News articles

fox_raw <- pdf_text("foxnews_articles_chunk1.pdf")
fox_text <- paste(fox_raw, collapse = "\n")

fox_chunks <- unlist(strsplit(fox_text, split = "\nHD ", fixed = TRUE))
fox_chunks <- paste0("HD ", fox_chunks)
fox_chunks <- trimws(fox_chunks)
fox_chunks <- fox_chunks[nchar(fox_chunks) > 200]

fox_corpus <- VCorpus(VectorSource(fox_chunks))
fox_clean <- tm_map(fox_corpus, content_transformer(tolower))
fox_clean <- tm_map(fox_clean, removePunctuation)
fox_clean <- tm_map(fox_clean, removeNumbers)
fox_clean <- tm_map(fox_clean, stripWhitespace)

fox_dtm <- DocumentTermMatrix(fox_clean)

fox_scores <- data.frame(
  regulation = count_dict_words(fox_dtm, regulation_dict),
  morality   = count_dict_words(fox_dtm, morality_dict),
  Outlet = "Fox"
)


########## Combine Outlets (NYT + MSNBC vs WSJ + FOX) ##########

all_scores_B <- bind_rows(
  nyt_scores, msnbc_scores,
  wsj_scores, fox_scores
)

all_scores_B$Ideology <- ifelse(
  all_scores_B$Outlet %in% c("NYT", "MSNBC"),
  "Left-Leaning",
  "Right-Leaning"
)

# Remove articles with no theme content
all_scores_B <- all_scores_B %>%
  filter(regulation + morality > 0)

# Aggregate
group_theme_props_B <- all_scores_B %>%
  group_by(Ideology) %>%
  summarise(
    total_regulation = sum(regulation),
    total_morality   = sum(morality),
    .groups = "drop"
  ) %>%
  mutate(
    total_theme = total_regulation + total_morality,
    Regulation  = total_regulation / total_theme,
    Morality    = total_morality   / total_theme
  )

group_theme_long_B <- pivot_longer(
  group_theme_props_B,
  cols = c("Regulation", "Morality"),
  names_to = "Theme",
  values_to = "Proportion"
)

group_theme_long_B$Ideology <- factor(
  group_theme_long_B$Ideology,
  levels = c("Left-Leaning", "Right-Leaning")
)


# X-axis labels
levels(group_theme_long_B$Ideology) <- c(
  "Left-Leaning\n(NYT, MSNBC)",
  "Right-Leaning\n(WSJ, Fox)"
)

# FINAL PLOT:
jpeg("Figure_4.jpeg", width = 600, height = 500, quality = 100)

ggplot(group_theme_long_B, aes(x = Ideology, y = Proportion, fill = Theme)) +
  geom_col(position = position_dodge(width = 0.6), width = 0.55) +
  geom_text(aes(label = percent(Proportion, accuracy = 1)),
            position = position_dodge(width = 0.6),
            vjust = -0.3, size = 5, family = "serif") +
  scale_fill_manual(values = c("Regulation" = "#2c7bb6", "Morality" = "#d73027")) +
  scale_y_continuous(
    labels = percent_format(accuracy = 1),
    limits = c(0, 0.9)    
  ) +
  labs(x = NULL, y = NULL) +
  theme_minimal(base_family = "serif") +
  theme(
    panel.grid = element_blank(),   # remove all gridlines
    axis.line = element_line(),     # add clean axes
    legend.title = element_blank()
  )

dev.off()




#######################
#### Table 3: Cause of the Scandal by Partisanship of Respondent and News Source
#######################

# Filtered dataset used for use in summary table

df <- Data_Obs_Combined %>%
  filter(scandal_aware_w5 != "Unaware",
         lr_trinary != "Center") %>%
  drop_na(lr_trinary, scandal_aware_w5, source_left_right2)


# Calculating percentage of people agreeing that lack of regulation is the cause of the scandal

Cause_Lack_Regulation <- df %>%
  group_by(lr_trinary, source_left_right2) %>%
  summarise(
    N = n(),
    Lack_Reg = mean(cause_lack_of_regulation, na.rm = TRUE),
    .groups = "drop"
  )

# Calculating percentage of people agreeing that individual moral failings is the cause of the scandal

Cause_Moral_Failings <- df %>%
  group_by(lr_trinary, source_left_right2) %>%
  summarise(
    Moral_Fail = mean(cause_individual_moral_failings, na.rm = TRUE),
    .groups = "drop"
  )

# Merge together and formatting table

merged <- Cause_Lack_Regulation %>%
  left_join(Cause_Moral_Failings,
            by = c("lr_trinary", "source_left_right2"))

Final_Table <- merged %>%
  mutate(
    `Political Orientation`       = ifelse(lr_trinary == "Left", "Left", "Right"),
    `Partisan Lean of News Source` = source_left_right2,
    `Moral Failings is the Cause`  = paste0(round(Moral_Fail * 100), "%"),
    `Lack of Regulation is the Cause` = paste0(round(Lack_Reg * 100), "%")
  ) %>%
  select(`Political Orientation`,
         `Partisan Lean of News Source`,
         N,
         `Moral Failings is the Cause`,
         `Lack of Regulation is the Cause`)

Final_Table

write.csv(Final_Table, "Table_3.csv", row.names = FALSE)




#######################
#### Figure 6 = Effect of Scandal Treatment on Regulatory Preferences Moderated Partisan Identity
#######################

# Cleaning data
Data_Exp$age_groups <- ifelse(Data_Exp$age < 35, 0,
                              ifelse(Data_Exp$age > 34 & Data_Exp$age < 50, 1,
                                     ifelse(Data_Exp$age>49 & Data_Exp$age < 63, 2,3)))
Data_Exp$age_groups = factor(Data_Exp$age_groups, levels = c(0, 1, 2, 3), labels = c('Below 35', '35 - 50', '50 - 62', '63+'))
tabyl(Data_Exp$age_groups)


# Running Analysis

jpeg("Figure_6.jpeg", width = 676, height = 447, quality = 100)

mod2 <- lm(crypto_3item_reg_score_factor_WaveB ~ Treatment_Group*party_id_7point + age_groups + gender + Income + educ_fourlevels, 
           data=Data_Exp)
summary(mod2)

par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[10] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[10, 10] + 2 * thermo_sim * vcov(mod2)[2, 10])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     main = "Figure 6: Treatment Effect on Support for Crypto \nRegulation Conditional on Partisan Identity",
     ylim = c(-0.8,0.8), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Exp$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()

# Showing the treatment effect among Republicans only
mod2 <- lm(crypto_3item_reg_score_factor_WaveB ~ Treatment_Group, 
           data=subset(Data_Exp, party_id_7point > 4))
summary(mod2)



#######################
#### Online Appendix B – Validating the Cryptocurrency Regulation Scale
#######################

# Creating variable sets 
vars_w1 <- c("crypto_regul1", "crypto_regul3", "crypto_regul5")     # Observational Wave 1
vars_w2 <- c("crypto_regul3", "crypto_regul5", "crypto_regul8")     # Observational Wave 2
vars_exp<- c("Crypto_Regulation_1_WaveA", "Crypto_Regulation_3_WaveA", "Crypto_Regulation_4_WaveA")  # Experimental

# Running factor analyses 
fa_w1  <- fa(Data_Obs_1[, vars_w1], nfactors = 1, rotate = "Promax", cor = "poly")
fa_w2  <- fa(Data_Obs_2[, vars_w2], nfactors = 1, rotate = "Promax", cor = "poly")
fa_exp <- fa(Data_Exp[,   vars_exp], nfactors = 1, rotate = "Promax", cor = "poly")

# Extract the factor loadings and placing them in the correct points with empty vectors as needed
load_w1  <- as.numeric(as.matrix(fa_w1$loadings)[, 1])
load_w2  <- as.numeric(as.matrix(fa_w2$loadings)[, 1])
load_exp <- as.numeric(as.matrix(fa_exp$loadings)[, 1])

w1_vals  <- rep(NA_real_, 4)
w2_vals  <- rep(NA_real_, 4)
exp_vals <- rep(NA_real_, 4)

w1_vals[1:3] <- load_w1[c(2,3,1)]
w2_vals[c(1,2,4)] <- load_w2[c(1,2,3)]
exp_vals[c(1,2,4)] <- load_exp[c(1,2,3)]


# Calculating Cronbach's alpha for each dataset 
df_w1 <- Data_Obs_1 %>% drop_na(all_of(vars_w1)) %>% select(all_of(vars_w1))
df_w2 <- Data_Obs_2 %>% drop_na(all_of(vars_w2)) %>% select(all_of(vars_w2))
df_exp<- Data_Exp   %>% drop_na(all_of(vars_exp)) %>% select(all_of(vars_exp))

alpha_w1  <- cronbach.alpha(df_w1)$alpha
alpha_w2  <- cronbach.alpha(df_w2)$alpha
alpha_exp <- cronbach.alpha(df_exp)$alpha

# Build final table 
item_labels <- c(
  "Item 1",
  "Item 2",
  "Item 3 (Version 1)",
  "Item 3 (Version 2)"
)

table_loadings <- data.frame(
  `Cryptocurrency Regulation Items` = item_labels,
  `Observational Wave 1` = sprintf("%.2f", w1_vals),
  `Observational Wave 2` = sprintf("%.2f", w2_vals),
  `Experimental Study`   = sprintf("%.2f", exp_vals),
  stringsAsFactors = FALSE,
  check.names = FALSE
)

# Append Cronbach's alpha row
alpha_row <- data.frame(
  `Cryptocurrency Regulation Items` = "Cronbach's alpha",
  `Observational Wave 1` = sprintf("%.2f", alpha_w1),
  `Observational Wave 2` = sprintf("%.2f", alpha_w2),
  `Experimental Study`   = sprintf("%.2f", alpha_exp),
  stringsAsFactors = FALSE,
  check.names = FALSE
)

final_table <- bind_rows(table_loadings, alpha_row)
final_table[ final_table == "NA" | is.na(final_table) ] <- "---"

# Print and save
print(final_table)
write.csv(final_table, "Table_B1.csv", row.names = FALSE, na = "")





#######################
#### Online Appendix D – Balance Test for Observational Study Wave 1
#######################

ProbitBalanceCheck <- glm(scandal_aware_numeric ~  
                            age + female + lr + educ_fourlevels + income + as.numeric(crypto_investor) 
                          + attentiveness + news_consumption + political_knowledge, data=Data_Obs_Combined) 
summary(ProbitBalanceCheck)

# Exporting this as a saved file

stargazer(ProbitBalanceCheck,
          type = "text",
          out = "Table_D1.txt",
          title = "Predicting Exposure",
          dep.var.labels = "Predicting Exposure",
          covariate.labels = c(
            "Age", "Gender", "Political Orientation", "Education",
            "Income", "Crypto / Bank Customer", "Attentiveness to news",
            "News consumption", "Political Knowledge"
          ),
          digits = 3,
          star.cutoffs = c(0.05, 0.01, 0.001),
          no.space = TRUE)



#######################
#### Online Appendix E – Regression Tables Comparing Support for Crypto Regulation Among Aware and Unaware Groups 
# in Observational Study Wave 1
#######################

# Model without covariates 

m1 <- lm(crypto_regul_135_factor_score ~ scandal_aware,
         data = Data_Obs_Combined)
summary(m1)

# Model with covariates 

m2 <- lm(crypto_regul_135_factor_score ~ scandal_aware + female + income,
         data = Data_Obs_Combined)
summary(m2)

# Exporting to file

stargazer(m1, m2,
          type = "text",
          out = "Table_E1.txt",
          
          title = "Table E1: Regressing Support for Crypto Regulation on Scandal Awareness",
          
          #keep = c("scandal_aware", "\\(Intercept\\)"),
          covariate.labels = c("Scandal Awareness", "Gender", "Income", "Constant"),
          
          column.labels = c("Model without covariates", "Model with covariates"),
          column.separate = c(1, 1),
          
          dep.var.labels.include = FALSE,
          dep.var.caption = "",
          dep.var.labels = "",
          
          omit.stat = c("adj.rsq", "ser", "f"),
          
          digits = 3,
          star.cutoffs = c(0.05, 0.01, 0.001),
          no.space = TRUE)




#######################
#### Online Appendix F – Regression Tables for Partisan Identity Interaction Models – Observational Study Wave 1
#######################

# Model with covariates 

model_1_with_covariates <- lm(crypto_regul_135_factor_score ~ scandal_aware*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
            data = Data_Obs_Combined)
summary(model_1_with_covariates)

# Model without covariates 

model_2_no_covariates <- lm(crypto_regul_135_factor_score ~ scandal_aware*party_id_7point , 
                              data = Data_Obs_Combined)
summary(model_2_no_covariates)

# Exporting to file

stargazer(model_1_with_covariates, model_2_no_covariates,
          type = "text",
          out = "Table_F1.txt",
          
          title = "Table F1: Regressing Support for Crypto Regulation on Scandal Exposure X Partisan Identity ",
          
          #keep = c("scandal_aware", "\\(Intercept\\)"),
          covariate.labels = c("Scandal Exposure", "Partisan Identity", "Age (35 – 50)", 
                               "Age (51 – 62)", "Age (63+)", "Gender (Male)",
                               "Income", "Education", "Crypto Investor Status",
                               "Scandal Exposure X Partisan Identity", "Constant"),
          
          column.labels = c("Model without covariates", "Model with covariates"),
          column.separate = c(1, 1),
          
          dep.var.labels.include = FALSE,
          dep.var.caption = "",
          dep.var.labels = "",
          
          omit.stat = c("adj.rsq", "ser", "f"),
          
          digits = 3,
          star.cutoffs = c(0.05, 0.01, 0.001),
          no.space = TRUE)




#######################
#### Online Appendix G – Replicating Main Results with Reconstructed Exposure Variables
#######################

# Stage 1 - First, we adopt a more stringent operationalization, whereby an exposed person is one who 
# correctly identified the scandal and answered at least one of the subsequent “depth of exposure” questions correctly. 

Data_Obs_Combined$scandal_aware_alternative <- ifelse(Data_Obs_Combined$scandal_depth > 1, 1, 0)
tabyl(Data_Obs_Combined$scandal_aware_alternative)


jpeg("Figure_G1.jpeg", width = 700, height = 450, quality = 100)

mod2 <- lm(crypto_regul_135_factor_score ~ scandal_aware_alternative*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
           data = Data_Obs_Combined)
summary(mod2)

par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[11] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[11, 11] + 2 * thermo_sim * vcov(mod2)[2, 11])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     #main = "Effect of Reconstructed Scandal Awareness on Regulatory Preferences \nConditional on Partisan Identity",
     ylim = c(-0.8,0.8), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Obs_Combined$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()


# Stage 2 - we replace the binary variable of scandal awareness with the ordinal variable of scandal depth. 

jpeg("Figure_G2.jpeg", width = 700, height = 450, quality = 100)

mod2 <- lm(crypto_regul_135_factor_score ~ scandal_depth*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
           data = Data_Obs_Combined)
summary(mod2)


par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[11] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[11, 11] + 2 * thermo_sim * vcov(mod2)[2, 11])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     #main = "Effect of Depth of Scandal Awareness Treatment on Regulatory Preferences \nConditional on Partisan Identity",
     ylim = c(-0.4,0.4), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Obs_Combined$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()




#######################
#### Online Appendix H – Replicating Observational Study W1 Results with Matched Dataset
#######################

#Produce new dataset for matched data
Data_Obs_Combined.matched.dataset <- Data_Obs_Combined

#Clean the dataset to be matched --> can't have NAs in variables that are to be matched
Data_Obs_Combined.matched.dataset$female <- ifelse (Data_Obs_Combined.matched.dataset$female == "Female", 1, 0)
Data_Obs_Combined.matched.dataset$age[is.na(Data_Obs_Combined.matched.dataset$age)] = 999
Data_Obs_Combined.matched.dataset$income[is.na(Data_Obs_Combined.matched.dataset$income)] = 999
Data_Obs_Combined.matched.dataset$attentiveness[is.na(Data_Obs_Combined.matched.dataset$attentiveness)] = 999
Data_Obs_Combined.matched.dataset$female[is.na(Data_Obs_Combined.matched.dataset$female)] = 999
Data_Obs_Combined.matched.dataset$lr[is.na(Data_Obs_Combined.matched.dataset$lr)] = 999
Data_Obs_Combined.matched.dataset$political_knowledge[is.na(Data_Obs_Combined.matched.dataset$political_knowledge)] = 999
Data_Obs_Combined.matched.dataset$news_consumption[is.na(Data_Obs_Combined.matched.dataset$news_consumption)] = 999

Data_Obs_Combined.matched.dataset <- subset(Data_Obs_Combined.matched.dataset, age < 998 & income < 998 & female < 998 & political_knowledge < 998 &  news_consumption < 998 )

#Creating matched dataset
Data_Obs_Combined.matched.dataset <- matchit(scandal_aware ~ age + income + female  + political_knowledge + news_consumption, 
                                method = "nearest",
                                replace = T,
                                distance = "GLM",
                                estimand = "ATT",
                                data = Data_Obs_Combined.matched.dataset)

summary(Data_Obs_Combined.matched.dataset) # This shows a balance test for matched dataset

Data_Obs_Combined.matched.dataset <- match.data(Data_Obs_Combined.matched.dataset) # This turns the matched dataset back into a dataset 


# Now re-running the main interaction analysis with the smaller, matched dataset

jpeg("Figure_H1.jpeg", width = 700, height = 450, quality = 100)

mod2 <- lm(crypto_regul_135_factor_score ~ scandal_aware*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
           data = Data_Obs_Combined.matched.dataset)
summary(mod2)

par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[11] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[11, 11] + 2 * thermo_sim * vcov(mod2)[2, 11])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     main = "",
     ylim = c(-0.8,0.8), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Obs_Combined.matched.dataset$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()




#######################
#### Online Appendix I – Replicating the Results of the Observational Study W1 Findings
#######################

### Replicating the direct effects

summary(lm(crypto_reg_factor_score_3items ~ scandal_aware_w5, data = Data_Obs_Combined))


### Replicating the interaction effect

jpeg("Figure_I1.jpeg", width = 700, height = 450, quality = 100)

mod2 <- lm(crypto_reg_factor_score_3items ~ scandal_aware_w5*party_id_7point + age_groups + female + income + educ_fourlevels + crypto_investor, 
           data = Data_Obs_Combined)
summary(mod2)

par(mfrow=c(1,1),oma=c(1,1,0,0),mai=c(0.5,0.4,0,0),mar=c(4,4,3,1)) 
thermo_sim <- 1:7

treat <- coef(mod2)[2] + coef(mod2)[11] * thermo_sim
treat_se <- sqrt(vcov(mod2)[2, 2] + thermo_sim^2 * vcov(mod2)[11, 11] + 2 * thermo_sim * vcov(mod2)[2, 11])
plot(x = thermo_sim, y = treat, type = "p",pch=16,
     xlab = "Partisan Identity",
     ylab = "Treatment Effect",
     #main = "Effect of Scandal Treatment on Regulatory Preferences \nConditional on Partisan Identity",
     ylim = c(-0.8,0.8), cex.lab=1.1)
for(i in 1:7){
  lines(c(i,i),c(treat[i],treat[i] + 1.96 * treat_se[i]),lwd=2)
  lines(c(i,i),c(treat[i],treat[i] - 1.96 * treat_se[i]),lwd=2)
}
abline(h=0,lty="dashed")

par(new=T)
hist(Data_Obs_Combined$party_id_7point,xlab=NULL,ylab=NULL,axes=F,main=NULL,freq=F,col=rgb(0.1,0.1,0.1,0.1),ylim=c(0,2.5), breaks = c(0, 1, 2, 3, 4, 5, 6, 7))

dev.off()




#######################
#### Online Appendix K – Beliefs About Scandal Causes – Disaggregated by Political Orientation and Source of News
#######################


# The code below shows the percentage (mean) of people who agree that individual moral failings is the cause of the scandal 
# disaggregated by their political orientation (left vs right) and by the political leaning of 
# the source where they learned about the FTX scandal. As opposed to Table 3 in the main manuscript, we also 
# include data for centrists and for people who were unaware of the scandal prior to our questions.

Table_K1 <- Data_Obs_Combined %>%
  filter(!is.na(lr_trinary), !is.na(scandal_aware_w5)) %>%
  filter(!(scandal_aware_w5 == "Aware" & is.na(source_left_right2))) %>%
  
  group_by(scandal_aware_w5, lr_trinary, source_left_right2) %>%
  summarise(
    Count   = n(),
    Percent = mean(cause_individual_moral_failings, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  
  # Format fields for table output
  mutate(
    `Aware of Scandal` = scandal_aware_w5,
    `Political Orientation` = lr_trinary,
    
    # For Unaware rows, use NA for news source
    `Lean of Originating News Outlet` = if_else(
      scandal_aware_w5 == "Unaware",
      "NA",                              
      as.character(source_left_right2)
    ),
    
    `% of People who Believe that Individual Moral Failings is the Cause` = round(Percent, 2)
  ) %>%
  
  # Select final columns in correct order
  select(
    `Aware of Scandal`,
    `Political Orientation`,
    `Lean of Originating News Outlet`,
    Count,
    `% of People who Believe that Individual Moral Failings is the Cause`
  )

# View and export result
print(Table_K1)
write.csv(Table_K1, "Table_K1.csv", row.names = FALSE, na = "")





# The code below shows the percentage (mean) of people who agree that a lack of regulation is the cause of the scandal 
# disaggregated by their political orientation (left vs right) and by the political leaning of 
# the source where they learned about the FTX scandal. As opposed to Table 3 in the main manuscript, we also 
# include data for centrists and for people who were unaware of the scandal prior to our questions.

Table_K2 <- Data_Obs_Combined %>%
  filter(!is.na(lr_trinary), !is.na(scandal_aware_w5)) %>%
  filter(!(scandal_aware_w5 == "Aware" & is.na(source_left_right2))) %>%
  
  group_by(scandal_aware_w5, lr_trinary, source_left_right2) %>%
  summarise(
    Count   = n(),
    Percent = mean(cause_lack_of_regulation, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  
  # Format fields for table output
  mutate(
    `Aware of Scandal` = scandal_aware_w5,
    `Political Orientation` = lr_trinary,
    
    # For Unaware rows, use NA for news source
    `Lean of Originating News Outlet` = if_else(
      scandal_aware_w5 == "Unaware",
      "NA",                              
      as.character(source_left_right2)
    ),
    
    #Percent = round(Percent, 2)
    `% of People who Believe that Lack of Regulation is the Cause` = round(Percent, 2)
  ) %>%
  
  # Select final columns in correct order
  select(
    `Aware of Scandal`,
    `Political Orientation`,
    `Lean of Originating News Outlet`,
    Count,
    `% of People who Believe that Lack of Regulation is the Cause`
  )

# View and export result
print(Table_K2)
write.csv(Table_K2, "Table_K2.csv", row.names = FALSE, na = "")



#######################
#### Online Appendix N – Regression Tables for Partisan Identity Interaction Models – Experimental Study
#######################

modelN1 <- lm(crypto_3item_reg_score_factor_WaveB ~ Treatment_Group*party_id_7point + age_groups + gender + Income + educ_fourlevels, 
           data=Data_Exp)
summary(modelN1)

modelN2 <- lm(crypto_3item_reg_score_factor_WaveB ~ Treatment_Group*party_id_7point , 
           data=Data_Exp)
summary(modelN2)


# Exporting to file

stargazer(modelN1, modelN2,
          type = "text",
          out = "Table_N1.txt",
          
          title = "Table N1: Regressing Support for Crypto Regulation on Scandal Exposure X Partisan Identity in the US",
          
          #keep = c("scandal_aware", "\\(Intercept\\)"),
          covariate.labels = c("Scandal Exposure", "Partisan Identity", "Age (35 – 50)", 
                               "Age (51 – 62)", "Age (63+)", "Gender (Male)",
                               "Income", "Education", 
                               "Scandal Exposure X Partisan Identity", "Constant"),
          
          column.labels = c("Model without covariates", "Model with covariates"),
          column.separate = c(1, 1),
          
          dep.var.labels.include = FALSE,
          dep.var.caption = "",
          dep.var.labels = "",
          
          omit.stat = c("adj.rsq", "ser", "f"),
          
          digits = 3,
          star.cutoffs = c(0.05, 0.01, 0.001),
          no.space = TRUE)




#######################
#### Online Appendix O – Interacting Experimental Treatment with Alternate Socio-Demographic Moderator Variables
#######################

# Variables you want to interact with Treatment_Group
vars <- c("age", "gender", "educ_fourlevels", "Income", 
          "cognition_avg", "Trust_Gov_WaveA")

# Fit models and extract coefficients for the interaction terms
results <- map_dfr(vars, function(v) {
  formula_str <- paste0("crypto_3item_reg_score_factor_WaveB ~ Treatment_Group*", v)
  model <- lm(as.formula(formula_str),
              data = Data_Exp)
  
  tidy(model, conf.int = TRUE) %>%
    filter(grepl("Treatment_Group.*:", term)) %>%
    mutate(variable = v)
})


# Plot and save interaction coefficients with 95% CI

jpeg("Figure_O1.jpeg", width = 777, height = 430, quality = 100)

ggplot(results, aes(x = variable, y = estimate)) +
  geom_point() +
  geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(x = "\nModerating Variable",
       y = "Interaction Effect\n",
       title = "") +
  ylim(-0.3, 0.3) +
  theme_classic() + 
  scale_x_discrete(labels = c(
    "age"            = "Age",
    "gender"         = "Gender",
    "educ_fourlevels"= "Education",
    "Income"         = "Income",
    "cognition_avg"  = "Need for \nCognition",
    "Trust_Gov_WaveA"= "Trust in \nGovernment"))

dev.off()
